COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	OWN REAL PXLO,PXHI,PYLO,PYHI OWN INTEGER PPIC
C00006 00003	PROCEDURE FPOLY(INTEGER N REFERENCE REAL XV,YV REAL BRITE)
C00009 ENDMK
C⊗;
OWN REAL PXLO,PXHI,PYLO,PYHI; OWN INTEGER PPIC;

PROCEDURE PSCREEN(REAL XL,YL,XH,YH; REFERENCE INTEGER PC);
   BEGIN
   PXLO←XL;
   PXHI←XH;
   PYLO←YL;
   PYHI←YH;
   PPIC←LOCATION(PC);
   END;

PROCEDURE DIT(REAL X1,Y1,BRITE);
   BEGIN
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   ADDIEL(MEMORY[PPIC],Y1,X1,BRITE);
   END;

PROCEDURE THIN(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY; REAL I; INTEGER ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1; DX←DX; DY←DY;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 0.5 UNTIL LEN DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,BRITE/2);
   COMMENT  ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE);
   END;

PROCEDURE FADE(REAL X1,Y1,X2,Y2,BRITE1,BRITE2);
   BEGIN
   REAL LEN,DX,DY; INTEGER I,ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE1←BRITE1*MEMORY[PPIC+BMAX];
   BRITE2←BRITE2*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 1 UNTIL ILEN-1 DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,(BRITE2*I+BRITE1*(ILEN-I))/ILEN);
   ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE2);
   END;

PROCEDURE BALL(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY,XR,YR,XC,YC,T;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   XC←(X1+X2)/2;
   YC←(Y1+Y2)/2;
   XR←(X1-X2)/2;
   YR←(Y1-Y2)/2;
   T←0;
   WHILE T<2*3.14159265 DO
      BEGIN
      REAL X,Y;
      X←XR*COS(T); Y←YR*SIN(T);
      ADDIEL(MEMORY[PPIC],YC+Y,XC+X,BRITE);
      T←T+1/SQRT(X↑2+Y↑2);
      END;
   END;
PROCEDURE FPOLY(INTEGER N; REFERENCE REAL XV,YV; REAL BRITE);
   BEGIN "POLY"
   REQUIRE "{}" DELIMITERS;
   REAL ARRAY IX,IY[0:N-1];

   REAL YMIN,YMAX; INTEGER M;
   REAL LX1,LX2,LY1,LY2;
   REAL RX1,RX2,RY1,RY2;
   INTEGER LEDGE,REDGE,LNXT,RNXT,I,J,LINENO,LOWY,HIGY,LOWX,HIGX;
   
   DEFINE X(I)={MEMORY[LOCATION(XV)+I,REAL]};
   DEFINE Y(I)={MEMORY[LOCATION(YV)+I,REAL]};

   M←N-1;  LEDGE←0;
   IX[0]←MEMORY[PPIC+LNBY]*(X(0)-PXLO)/(PXHI-PXLO);
   YMIN←YMAX←IY[0]←MEMORY[PPIC+PCLN]*(Y(0)-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];

   FOR I←1 STEP 1 UNTIL M DO
      BEGIN
      IX[I]←MEMORY[PPIC+LNBY]*(X(I)-PXLO)/(PXHI-PXLO);
      IY[I]←MEMORY[PPIC+PCLN]*(Y(I)-PYHI)/(PYLO-PYHI);
      IF IY[I]<YMIN THEN BEGIN LEDGE←I; YMIN←IY[I] END;
      IF IY[I]>YMAX THEN YMAX←IY[I];
      END;

   REDGE←LEDGE;

   LX1 ← IX[LEDGE];
   LY1 ← IY[LEDGE];
   LNXT←(LEDGE+1) MOD N;
   LX2 ← IX[LNXT];
   LY2 ← IY[LNXT];

   RX1 ← IX[REDGE];
   RY1 ← IY[REDGE];
   RNXT←(REDGE+N-1) MOD N;
   RX2 ← IX[RNXT];
   RY2 ← IY[RNXT];

   LOWY←YMIN+0.5; HIGY←YMAX-0.5;

   LOWY←LOWY MAX 0; HIGY←HIGY MIN (MEMORY[PPIC+PCLN]-1);

   FOR LINENO←LOWY STEP 1 UNTIL HIGY DO
      BEGIN

      WHILE LY2<LINENO+.5 DO
         BEGIN
         LEDGE←LNXT;
	 LX1 ← LX2;
	 LY1 ← LY2;
	 LNXT←(LEDGE+1) MOD N;
	 LX2 ← IX[LNXT];
	 LY2 ← IY[LNXT];
         END;

      WHILE RY2<LINENO+.5 DO
         BEGIN
         REDGE←RNXT;
	 RX1 ← RX2;
	 RY1 ← RY2;
	 RNXT←(REDGE+N-1) MOD N;
	 RX2 ← IX[RNXT];
	 RY2 ← IY[RNXT];
         END;

      LOWX ← (LINENO+.5-LY1)*(LX2-LX1)/(LY2-LY1)+LX1 + 0.5;
      HIGX ← (LINENO+.5-RY1)*(RX2-RX1)/(RY2-RY1)+RX1 - 0.5;

      LOWX←LOWX MAX 0;
      HIGX←HIGX MIN MEMORY[PPIC + LNBY];

      FOR J←LOWX STEP 1 UNTIL HIGX DO PUTEL(MEMORY[PPIC],LINENO,J,BRITE);
      END;

   END "POLY";